home *** CD-ROM | disk | FTP | other *** search
/ Windows News 2003 February / Windows News Numéro 107 février 2003.iso / Rédaction / Loto / Loto.txt next >
Encoding:
Text File  |  2002-12-12  |  7.4 KB  |  282 lines
  1. 'Module1 (Code)
  2. Option Explicit
  3. Public ChoixNumΘros(5), NumΘros(49), RΘsultats(6)
  4. Public i, j, NbreGrilles, Nb, k, Li, Col As Byte
  5. Dim cell As Range
  6.  
  7. '************  feuille bulletin ***********
  8. 'Clic sur le bouton Jouer dans la feuille bulletin
  9. Sub Jouer()
  10.   Load FrmJouer
  11.   FrmJouer.Opt2 = True
  12.   FrmJouer.Show
  13. End Sub
  14.  
  15. 'Fonction personnalisΘe utilisΘe dans les cellules C6, 06,
  16. Function NbSelections(Plage)
  17. Nb = 0
  18. For Each cell In Plage
  19.     If cell.Interior.ColorIndex = 3 Or cell.Interior.ColorIndex = 4 Then
  20.         Nb = Nb + 1
  21.     End If
  22. Next
  23. NbSelections = Nb
  24. End Function
  25.  
  26. Function Calculer()
  27.   Range("C24:C25,O24:O25,AA24:AA25,AM24:AM25,AY24:AY25,BK24:BK25,BW24:BW25,CI24:CI25").Calculate
  28. End Function
  29.  
  30. 'Routine de tirage au hasard des 6 numΘros appelΘe par la procΘdure
  31. 'exΘcutΘe lors du clic sur le bouton OK du formulaire FrmJouer
  32. Sub Choix()
  33. For i = 1 To 49
  34.     NumΘros(i) = False
  35. Next
  36. For i = 0 To 5
  37.     ChoixNumΘros(i) = Int(Rnd * 49) + 1
  38.     If Not NumΘros(ChoixNumΘros(i)) Then
  39.         NumΘros(ChoixNumΘros(i)) = True
  40.     Else
  41.         i = i - 1
  42.     End If
  43. Next
  44. End Sub
  45.  
  46. 'Clic sur le bouton Effacer dans la feuille bulletin
  47. Sub EffacerGrilles()
  48. Dim strRange As String
  49.   If NbreGrilles = Empty Or NbreGrilles = 0 Then
  50.     i = 0
  51.     For k = 1 To 8
  52.      If Range("Grille" & k).Interior.ColorIndex = 15 Then
  53.         Range("Grille" & k).Interior.ColorIndex = 2
  54.         i = i + 1
  55.      End If
  56.     Next k
  57.       NbreGrilles = i
  58.   End If
  59.   Select Case NbreGrilles
  60.     Case 1 To 2
  61.       strRange = "C3:W21"
  62.     Case 3 To 4
  63.       strRange = "C3:AU21"
  64.     Case 5 To 6
  65.       strRange = "C3:BS21"
  66.     Case 7 To 8
  67.       strRange = "C3:CQ21"
  68.     Case Else
  69.       strRange = "C3:CQ21"
  70.   End Select
  71. For Each cell In Range(strRange)
  72.   If cell.Font.ColorIndex = 2 Or cell.Font.ColorIndex = 5 Or cell.Font.ColorIndex = 6 Then
  73.      cell.Font.ColorIndex = 3
  74.      cell.Interior.ColorIndex = 2
  75.   End If
  76. Next
  77. Calculer
  78. End Sub
  79.  
  80. '************  feuille tirage ***********
  81. 'Clic sur le bouton Effacer
  82. Sub EffacerRΘsultats()
  83. For Each cell In Range("A1:M24")
  84.   If cell.Font.ColorIndex = 2 Then
  85.     cell.Font.ColorIndex = 3
  86.     cell.Interior.ColorIndex = 2
  87.   End If
  88. Next
  89. Calculer
  90. End Sub
  91.  
  92. 'Clic sur le bouton Contr⌠ler
  93. Sub Controle()
  94. Dim Gagnants As Byte
  95. i = 0
  96. 'Chaque cellule de la grille du tirage est examinΘe
  97. For Each cell In Range("C4:K22")
  98. 'L'un des 6 premiers numΘros tirΘs
  99.     If cell.Interior.ColorIndex = 3 Then
  100.         RΘsultats(i) = cell.Value
  101.         i = i + 1
  102.     End If
  103. 'Le numΘro complΘmentaire
  104.     If cell.Interior.ColorIndex = 4 Then
  105.         RΘsultats(6) = cell.Value
  106.     End If
  107. Next
  108. 'SΘlection de la feuille bulletin
  109. Sheets("bulletin").Select
  110. 'la boucle qui examine chaque grille
  111. For i = 1 To 8
  112.   Gagnants = 0
  113.   Range("Grille" & i).Select
  114. 'Recherche des 6 premiers numΘros dans la grille
  115.   For j = 0 To 5
  116.     Li = (RΘsultats(j) Mod 10) * 2
  117.     Col = (Int(RΘsultats(j) / 10)) * 2
  118.       If ActiveCell.Offset(Li, Col).Font.ColorIndex = 2 Then
  119.         ActiveCell.Offset(Li, Col).Font.ColorIndex = 5
  120.         Gagnants = Gagnants + 1
  121.       End If
  122.   Next j
  123. 'S'il y a 5 numΘros gagnants, recherche du numΘro complΘmentaire
  124.     If Gagnants = 5 Then
  125.         Li = (RΘsultats(6) Mod 10) * 2
  126.         Col = (Int(RΘsultats(6) / 10)) * 2
  127.         If ActiveCell.Offset(Li, Col).Font.ColorIndex = 2 Then
  128.             ActiveCell.Offset(Li, Col).Font.ColorIndex = 6
  129.             Gagnants = Gagnants + 1
  130.         End If
  131.     End If
  132. Next i
  133. Range("A1").Select
  134. End Sub
  135.  
  136. '*************************************************************************************
  137. 'Feuille1 (Code)
  138. Option Explicit
  139.  
  140. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  141. Dim Colonne, NbreNumΘros As Byte
  142. Cancel = True
  143. Colonne = Target.Column
  144. Select Case Colonne
  145.     Case 3 To 11
  146.         NbreNumΘros = Range("Nbre1").Value
  147.         k = 1
  148.     Case 15 To 23
  149.         NbreNumΘros = Range("Nbre2").Value
  150.         k = 2
  151.     Case 27 To 35
  152.         NbreNumΘros = Range("Nbre3").Value
  153.         k = 3
  154.     Case 39 To 47
  155.         NbreNumΘros = Range("Nbre4").Value
  156.         k = 4
  157.     Case 51 To 59
  158.         NbreNumΘros = Range("Nbre5").Value
  159.         k = 5
  160.     Case 63 To 71
  161.         NbreNumΘros = Range("Nbre6").Value
  162.         k = 6
  163.     Case 75 To 83
  164.         NbreNumΘros = Range("Nbre7").Value
  165.         k = 7
  166.     Case 87 To 95
  167.         NbreNumΘros = Range("Nbre8").Value
  168.         k = 8
  169. End Select
  170. On Error Resume Next
  171. If Val(Target.Value) >= 1 And Target.Font.Size < 18 Then
  172.     If Target.Font.ColorIndex = 2 Then
  173.         Target.Font.ColorIndex = 3
  174.         Target.Interior.ColorIndex = 2
  175.     Else
  176.         If NbreNumΘros = 6 Then
  177.             MsgBox "Cette grille est dΘjα complΦte"
  178.             Exit Sub
  179.         End If
  180.         Target.Font.ColorIndex = 2
  181.         Target.Interior.ColorIndex = 3
  182.     End If
  183. End If
  184. Calculer
  185.     If Range("Nbre" & k).Value >= 1 And Range("Grille" & k).Interior.ColorIndex = 2 Then
  186.         Range("Grille" & k).Interior.ColorIndex = 15
  187.       ElseIf Range("Nbre" & k).Value = 0 And Range("Grille" & k).Interior.ColorIndex = 15 Then
  188.        Range("Grille" & k).Interior.ColorIndex = 2
  189.     End If
  190. End Sub
  191.  
  192. Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
  193.   If ActiveCell.Address = Range("A1").Address Then
  194.       Range("D27").Select
  195.         Else: Exit Sub
  196.   End If
  197. End Sub
  198.  
  199. Private Sub Worksheet_Activate()
  200.   Range("D27").Select
  201. End Sub
  202.  
  203.  
  204. '*************************************************************************************
  205. 'Feuille2 (Code)
  206. Option Explicit
  207.  
  208. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  209. Dim NbreNumΘros As Byte
  210. Cancel = True
  211. NbreNumΘros = Range("Nbre").Value
  212. On Error Resume Next
  213. If Val(Target.Value) >= 1 And Target.Font.Size < 18 Then
  214.     If Target.Font.ColorIndex = 2 Then
  215.         Target.Font.ColorIndex = 3
  216.         Target.Interior.ColorIndex = 2
  217.     Else
  218.         If NbreNumΘros = 7 Then
  219.             MsgBox "Cette grille est dΘjα complΦte"
  220.             Exit Sub
  221.         End If
  222.         If NbreNumΘros < 6 Then
  223.             Target.Font.ColorIndex = 2
  224.             Target.Interior.ColorIndex = 3
  225.         Else
  226.             Target.Font.ColorIndex = 2
  227.             Target.Interior.ColorIndex = 4
  228.         End If
  229.     End If
  230. End If
  231. Calculer
  232. End Sub
  233.  
  234. Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
  235.   If ActiveCell.Address = Range("A1").Address Then
  236.       Range("O3").Select
  237.         Else: Exit Sub
  238.   End If
  239. End Sub
  240.  
  241. Private Sub Worksheet_Activate()
  242.   Range("O3").Select
  243. End Sub
  244.  
  245. '*************************************************************************************
  246. 'FrmJouer (code)
  247. Option Explicit
  248.  
  249. 'Clic sur le bouton Annuler
  250. Private Sub CmdAnnuler_Click()
  251. Unload FrmJouer
  252. End Sub
  253.  
  254. 'Clic sur le bouton OK
  255. Private Sub CmdOK_Click()
  256.   If FrmJouer.Opt2 Then
  257.     NbreGrilles = 2
  258.   ElseIf FrmJouer.Opt4 Then
  259.     NbreGrilles = 4
  260.   ElseIf FrmJouer.Opt6 Then
  261.     NbreGrilles = 6
  262.   ElseIf FrmJouer.Opt8 Then
  263.     NbreGrilles = 8
  264.   End If
  265.   Unload FrmJouer
  266.   EffacerGrilles
  267. For k = 1 To NbreGrilles
  268.     Choix
  269.     Range("Grille" & k).Select
  270.     Range("Grille" & k).Interior.ColorIndex = 15
  271.     For j = 0 To 5
  272.         Li = (ChoixNumΘros(j) Mod 10) * 2
  273.         Col = (Int(ChoixNumΘros(j) / 10)) * 2
  274.         ActiveCell.Offset(Li, Col).Font.ColorIndex = 2
  275.         ActiveCell.Offset(Li, Col).Interior.ColorIndex = 3
  276.     Next j
  277. Next k
  278. Calculer
  279. Range("A1").Select
  280. NbreGrilles = 0
  281. End Sub
  282.